home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1996 January / macformat-033.iso / mac / Shareware City / Developers / CGIshell Folder / Pocket 6.4 / Examples / SANETrig < prev    next >
Encoding:
Text File  |  1992-05-07  |  1.7 KB  |  57 lines  |  [TEXT/McSk]
  1. ( SANETrig  floating point trig for Pocket Forth 0.6 )
  2. forget task : task ; decimal
  3.  
  4. : 0F< ( f -- flag ) ( true if f is less than zero )
  5.     0. fcompare >r fdrop fdrop r> 0< ;
  6. : K  ( n -- n[mod[360]] ) ( keep n within one circle )
  7.     360. frem 0.0 fcompare
  8.     0< IF fdrop 360. THEN f+ ;
  9.  
  10. 57.2957795131 fconstant DPR  ( degrees per radian )
  11. : SIN ( deg -- sin[deg] ) dpr f/ fsin ;
  12. : COS ( deg -- cos[deg] ) dpr f/ fcos ;
  13.  
  14. : ATAN ( fy fx -- atan[y/x] )
  15.     fdup 3 froll f/
  16.     fatn dpr f*  ( degrees )
  17.     fswap 0f< >r
  18.     fdup 0f< IF        ( atn is negative )
  19.       r> IF            (   y is negative )
  20.         360. f+        ( quadrant IV )
  21.       ELSE             (   y is positive )
  22.         180. f+        ( quadrant II )
  23.       THEN
  24.     ELSE               ( atn is positive )
  25.       r> IF            (   y is negative )
  26.         180. f+        ( quadrant III )
  27.       THEN             ( quadrant I   )
  28.     THEN ;
  29.  
  30. : ASIN ( f -- asin[f] )
  31.     fdup fabs 1.16415321827e-10 fcompare  ( -- x y 1e-10 flag )
  32.     >r fdrop r> 0> IF  ( -- x y )
  33.       fdup 0.5 fcompare >r fdrop fdrop r> 0> IF
  34.         1. fswap f-
  35.         fdup 2. f* fswap fdup f* f-
  36.       ELSE
  37.         1. fswap fdup f* f-
  38.       THEN
  39.       fsqrt f/ fatn
  40.     ELSE
  41.       fdrop
  42.     THEN
  43.     dpr f* ;  ( convert to degrees )
  44.  
  45. : TEST  ( test this out )  4 fix
  46.     100 150 !pen  275 150 -to  275 75 -to  100 150 -to
  47.     277 120 !pen ." 3.0 cm."  170 162 !pen ." 7.5 cm."
  48.     128 148 !pen  7.5 3.0 atan f. 161 emit  cr ;
  49.  
  50. room page
  51. ( You have just added a quadrant correcting arctan function )
  52. ( and the arcsin function from page 71 of the Apple Numerics)
  53. ( Manual, 2nd Ed. See the SANETrig file for more information).
  54. ( bytes of dictionary space left. )
  55. test
  56.  
  57.